home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyTranslations.p < prev    next >
Encoding:
Text File  |  1993-10-01  |  2.8 KB  |  142 lines  |  [TEXT/PJMM]
  1. unit MyTranslations;
  2.  
  3. interface
  4.  
  5.     uses
  6.         MyTypes;
  7.  
  8.     type
  9.         transTable = packed array[char] of char;
  10.  
  11.     procedure GetTransTable (id: integer; out: boolean; var trans: transTable);
  12.     procedure TranslateBlock (p: ptr; count: longInt; var trans: transTable);
  13.     procedure TranslateHandle (h: handle; var trans: transTable);
  14.     procedure TranslateString (var s: string; var trans: transTable);
  15.     procedure TranslateEOLs (h: handle; dest: CRLFTypes);
  16.  
  17. implementation
  18.  
  19.     const
  20.         translateResType = 'taBL';
  21.  
  22. {$R-}
  23.  
  24.     procedure GetTransTable (id: integer; out: boolean; var trans: transTable);
  25.         var
  26.             th: handle;
  27.             tfs: FSSpec;
  28.             tres, i: integer;
  29.     begin
  30.         th := GetResource(translateResType, id);
  31.         if (th = nil) or (GetHandleSize(th) <> 512) then begin
  32.             for i := 0 to 255 do begin
  33.                 trans[chr(i)] := chr(i);
  34.             end;
  35.         end
  36.         else begin
  37.             BlockMove(ptr(ord(th^) + SizeOf(trans) * ord(out)), @trans, SizeOf(trans));
  38.         end;
  39.     end;
  40.  
  41.     procedure TranslateBlock (p: ptr; count: longInt; var trans: transTable);
  42.         var
  43.             i: longInt;
  44.     begin
  45.         for i := 1 to count do begin
  46.             p^ := ord(trans[chr(BAND(p^, $FF))]);
  47.             p := ptr(ord(p) + 1);
  48.         end;
  49.     end;
  50.  
  51.     procedure TranslateHandle (h: handle; var trans: transTable);
  52.     begin
  53.         TranslateBlock(h^, GetHandleSize(h), trans);
  54.     end;
  55.  
  56.     procedure TranslateString (var s: string; var trans: transTable);
  57.         var
  58.             i: integer;
  59.     begin
  60.         for i := 1 to length(s) do begin
  61.             s[i] := trans[s[i]];
  62.         end;
  63.     end;
  64.  
  65.     procedure TranslateToOne (h: handle; crlf: CRLFTypes; var lines: longInt);
  66.         var
  67.             p, q: ptr;
  68.             len, newlen, i: longInt;
  69.             which: integer;
  70.     begin
  71.         len := GetHandleSize(h);
  72.         lines := 0;
  73.         if crlf = CL_CR then begin
  74.             which := 13;
  75.         end
  76.         else begin
  77.             which := 10;
  78.         end;
  79.         p := h^;
  80.         q := h^;
  81.         i := 1;
  82.         newlen := 0;
  83.         while i <= len do begin
  84.             if p^ = 13 then begin
  85.                 q^ := which;
  86.                 lines := lines + 1;
  87.                 p := ptr(ord(p) + 1);
  88.                 if p^ = 10 then begin
  89.                     p := ptr(ord(p) + 1);
  90.                 end;
  91.             end
  92.             else if p^ = 10 then begin
  93.                 q^ := which;
  94.                 lines := lines + 1;
  95.                 p := ptr(ord(p) + 1);
  96.             end
  97.             else begin
  98.                 q^ := p^;
  99.                 p := ptr(ord(p) + 1);
  100.             end;
  101.             q := ptr(ord(q) + 1);
  102.             newlen := newlen + 1;
  103.             i := i + 1;
  104.         end;
  105.         SetHandleSize(h, newlen);
  106.     end;
  107.  
  108.     procedure TranslateCRtoCRLF (h: handle; lines: longInt);
  109.         var
  110.             p, q: ptr;
  111.             len, i: longInt;
  112.             which: integer;
  113.     begin
  114.         len := GetHandleSize(h);
  115.         SetHandleSize(h, len + lines);
  116.         p := ptr(ord(h^) + len);
  117.         q := ptr(ord(h^) + len + lines);
  118.         for i := 1 to len do begin
  119.             p := ptr(ord(p) - 1);
  120.             if p^ = 13 then begin
  121.                 q := ptr(ord(q) - 1);
  122.                 q^ := 10;
  123.             end;
  124.             q := ptr(ord(q) - 1);
  125.             q^ := p^;
  126.         end;
  127.     end;
  128.  
  129.     procedure TranslateEOLs (h: handle; dest: CRLFTypes);
  130.         var
  131.             lines: longInt;
  132.     begin
  133.         if dest = CL_CRLF then begin
  134.             TranslateToOne(h, CL_CR, lines);
  135.             TranslateCRtoCRLF(h, lines);
  136.         end
  137.         else begin
  138.             TranslateToOne(h, dest, lines);
  139.         end;
  140.     end;
  141.  
  142. end.